(include "./code.inc")
(include "./scopes.inc")
(include "./vp.inc")
(include "./vpopt.inc")
(include "./cscript.inc")
(include "./csopt.inc")
(include "./assign.inc")
(include "./lisp.inc")
(include "././trans/vp.inc")

(include "sys/pii/class.inc")
(include "sys/task/class.inc")

;;;;;;;;;;;
; functions
;;;;;;;;;;;

(defun link-sym (_) (str "rl_" _))
(defun path-sym (_) (str "rp_" _))
(defun string-sym (_) (str "rs_" _))

(defun fn-add-string (s)
	(defq i -1)
	(while (and (< (++ i) (length *strings*)) (nql s (elem-get *strings* i))))
	(if (= i (length *strings*)) (push *strings* s)) i)

(defun fn-add-path (p)
	(if (defq i (find p *paths*)) i
		(dec (length (push *paths* p)))))

(defun fn-add-link (p)
	(push *links* (fn-add-path p)))

(defun fn-find-link (p)
	(defq i -1)
	(while (and (< (++ i) (length *links*)) (nql p (elem-get *paths* (elem-get *links* i)))))
	(if (= i (length *links*)) (fn-add-link p)) i)

(defun fn-string (s r)
	(vp-lea-p (string-sym (fn-add-string s)) r))

(defun fn-bind (p r)
	(if (get p) (throw "can't bind to inline function !" p)
		(vp-cpy-pr (link-sym (fn-find-link p)) r)))

(defun fn-call (p)
	(if (get p) ((eval p))
		(vp-call-p (link-sym (fn-find-link p)))))

(defun fn-jump (p)
	(if (get p) (throw "can't jump to inline function !" p)
		(vp-jmp-p (link-sym (fn-find-link p)))))

(defun def-func (*func_name* &optional *func_align* *func_stack*)
	(defq *func_align* (ifn *func_align* stack_align)
		*strings* (clear '()) *paths* (clear '())
		*links* (clear '()) *emit_list* (clear '())
		*switch_stk* (clear '()) *switch* :nil *switch_nxt* 0)
(vp-label 'fn_start)
	(vp-long -1)
	(vp-short
		(label-sym 'fn_end)
		(label-sym 'fn_entry)
		(label-sym 'fn_links)
		(label-sym 'fn_paths)
		(ifn *func_stack* tk_stack_size))
(vp-label 'fn_name_start)
	(vp-cstr (str *func_name*))
	(vp-byte (list '- (label-sym 'fn_entry) (label-sym 'fn_name_start)))
	(vp-align +ptr_size (list '- (label-sym 'fn_entry) (label-sym 'fn_name_start)))
(vp-label 'fn_entry)
	(push-scope)
	(defq *emit_start* (length *emit_list*))
	(def *compile_env* '*func_env* (env))
	(env-push))

(defun def-func-end ()
	(env-pop)
	(undef *compile_env* '*func_env*)
	(defq *emit_end* (length *emit_list*))
	(pop-scope-checked)
	(each (lambda (s)
	(vp-label (string-sym (!)))
		(vp-cstr s)) *strings*)
	(vp-align +ptr_size)
(vp-label 'fn_links)
	(each (lambda (s)
	(vp-label (link-sym (!)))
		(vp-long (list '- (label-sym (path-sym s)) '*pc*))) *links*)
(vp-label 'fn_paths)
	(when (nempty? *paths*)
		(each (lambda (s)
		(vp-label (path-sym (!)))
			(vp-cstr (str s))) *paths*)
		(vp-align +ptr_size))
(vp-label 'fn_end)
	(opt-emit-list *emit_list* *emit_start* *emit_end*)
	(defq *emit_code* (emit-vp-code *emit_list*))
	(when (or *debug_emit* (eql *cpu* 'vp64))
		(defq *out* (cat "(" (join (map (const str) *emit_code*) (ascii-char 10)) ")"))
		(if (eql *cpu* 'vp64) (save *out* (cat "obj/vp/" (str *func_name*))))
		(if *debug_emit* (print *out*)))
	(defq *out* (emit-translate *emit_code*))
	(save *out* (cat "obj/" *cpu* "/" *abi* "/" (str *func_name*)))
	(print "-> " (str "obj/" *cpu* "/" *abi* "/" (str *func_name*) " (" (length *out*) ")")))

(defun abort (&optional s)
	(call 'host_os :pii_write_str (list 2 (ifn s "Abort !")))
	(jump 'host_os :pii_exit '(1)))

(defun assert (b &optional d)
	(when (> *debug_mode* 0)
		(vpifnot b)
			(abort (ifn d "Assert Failure !"))
		(endif)))
